Syntax10.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
(*----------------------------------------------------------------------
Folds allows the compilation of folded texts automatically inserting error elements at the
error positions.
Folds.Compile  (^ | * | {filename} ~)
	compiles the specified text(s). If the text contains folds, they are silently unfolded
	before the compilation. Error elements are inserted at the error positions. They can
	be searched for with Folds.ShowError. Old error elements are removed before every
	new compilation and are not stored with Edit.Store. When called from the menu bar,
	Folds.Compile compiles the text in the viewer to which the menu belongs.
Folds.ShowError
	Sets the caret to the next error element after the previous caret position and displays
	an error message in the Log Viewer. If there is no caret set, ShowError shows the
	first error in the text. If an error element is contained in a folded text part, the fold
	is automatically expanded. ShowError expects a table of error numbers and error
	messages in a specific file (OberonErrors.Text for default).
Folds.Restore *
	Collapses all folds that were unfolded during Folds.ShowErrors in the marked viewer.
Folds.SetProfile
	A couple of settings are stored in the file Folds.Profile which is read when module Folds
	is loaded. When these settings are changed in Folds.Profile they can be reloaded with
	the command Folds.SetProfile. The default contents of Folds.Profile (which are also the
	default settings when Folds.Profile is missing) are as follows:
		compiler = Compiler.Compile /s
		errorFile = OberonErrors.Text
		showWarnings = yes
	The settings allow to select a different compiler, different default compilation options,
	and a different error message file. They also specify if error elements should be inserted for
	warnings.
----------------------------------------------------------------------*)
Syntax10i.Scn.Fnt
StampElems
Alloc
30 Jun 95
Syntax10b.Scn.Fnt
Syntax10.Scn.Fnt
Documentation
MODULE Folds;	(* HM 
IMPORT
	Display, Input, Files, Fonts, Oberon, Texts, Viewers, TextFrames, MenuViewers, FoldElems;
CONST
	profile = "Folds.Profile";
	unit = LONG(TextFrames.Unit);
	left = 2; middle = 1; right = 0;
	CR = 0DX;
	ErrElem = POINTER TO ErrElemDesc;
	ErrElemDesc = RECORD(Texts.ElemDesc)
		err: INTEGER
	END;
	Options = ARRAY 16 OF CHAR;
	w: Texts.Writer;
	errT: Texts.Text;
	compName, errFile: ARRAY 24 OF CHAR;
	globOpt: Options;
	showWarnings: BOOLEAN;
	errors: INTEGER;
PROCEDURE *NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);	
END NoNotify;
PROCEDURE *ErrCheck (e: Texts.Elem): BOOLEAN;	
BEGIN RETURN e IS ErrElem
END ErrCheck;
PROCEDURE GetOptions (VAR s: Texts.Scanner; VAR opt: ARRAY OF CHAR);	
	VAR i: INTEGER;
BEGIN i := 0;
	WHILE s.nextCh = " " DO Texts.Read(s, s.nextCh) END;
	IF (s.nextCh = "/") OR (s.nextCh = "\") THEN
		REPEAT opt[i] := s.nextCh; INC(i); Texts.Read(s, s.nextCh) UNTIL (CAP(s.nextCh) < "A") OR (CAP(s.nextCh) > "Z")
	END;
	opt[i] := 0X
END GetOptions;
PROCEDURE MarkedFrame (): TextFrames.Frame;	
	VAR v: Viewers.Viewer; x: LONGINT;
BEGIN v := Oberon.MarkedViewer();
	IF (v # NIL ) & (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN RETURN v.dsc.next(TextFrames.Frame)
	ELSE RETURN NIL
END MarkedFrame;
PROCEDURE OpenTempViewer (t: Texts.Text; VAR v: MenuViewers.Viewer);	
	VAR x, y, h: INTEGER;
BEGIN y := Display.Bottom; x := Display.Width-1; h := Viewers.minH; Viewers.minH := 1;
	v := MenuViewers.New(TextFrames.NewMenu("", ""),
 TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
	Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
	Viewers.minH := h
END OpenTempViewer;
PROCEDURE Show (f: TextFrames.Frame; pos: LONGINT);	
	VAR end, delta: LONGINT;
BEGIN delta := 200;
	LOOP end := TextFrames.Pos(f, f.X + f.W, f.Y);
		IF (f.org <= pos) & (pos < end) OR (f.org = end) THEN EXIT END;
		TextFrames.Show(f, pos - delta); DEC(delta, 20)
END Show;
PROCEDURE *HandleErr (E: Texts.Elem; VAR msg: Texts.ElemMsg);	
	VAR e: ErrElem; x, y, w, h: INTEGER; keys: SET;
BEGIN
	WITH E: ErrElem DO
		WITH
			 msg: TextFrames.DisplayMsg DO
				IF ~msg.prepare THEN
					w := SHORT(E.W DIV unit); h := SHORT(E.H DIV unit);
					Display.ReplConst(15, msg.X0 + 1, msg.Y0 + 1, w - 2, h-2, Display.replace)
				END
		| msg: TextFrames.TrackMsg DO
				IF msg.keys = {middle} THEN
					REPEAT
						Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
					UNTIL keys = {}
				END
		| msg: Texts.CopyMsg DO
				NEW(e); Texts.CopyElem(E, e); e.err := E.err; msg.e := e
		ELSE (*ignore it*)
		END
END HandleErr;
PROCEDURE InsertErrElems (F: TextFrames.Frame; t: Texts.Text; pos: LONGINT);	
	VAR S: Texts.Scanner; err: INTEGER; e: ErrElem;
BEGIN errors := 0;
	Texts.OpenScanner(S, Oberon.Log, pos); Texts.Scan(S);
	LOOP S.line := 0;
		IF S.eot THEN EXIT
		ELSIF (S.class = Texts.Name) & (S.s = "pos") THEN Texts.Scan(S);
			IF S.class = Texts.Int THEN pos := S.i ELSE EXIT END ;
			REPEAT Texts.Scan(S) UNTIL S.eot OR (S.class = Texts.Int);
			IF S.eot THEN EXIT
			ELSIF showWarnings OR (S.i < 300) OR (S.i > 399) THEN
				NEW(e); e.W := Fonts.Default.height * unit; e.H := e.W;
				e.handle := HandleErr; e.err := SHORT(S.i);
				Texts.WriteElem(w, e); Texts.Insert(t, pos + errors, w.buf);
				INC(errors)
			END
		END ;
		REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
END InsertErrElems;
PROCEDURE DeleteErrElems (t: Texts.Text);	
	VAR r: Texts.Reader; pos: LONGINT;
BEGIN Texts.OpenReader(r, t, 0);
	LOOP Texts.ReadElem(r);
		IF r.elem = NIL THEN EXIT
		ELSIF r.elem IS ErrElem THEN
			pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos-1)
		END
END DeleteErrElems;
(*PROCEDURE ErrVisible (f: TextFrames.Frame): BOOLEAN;	
	VAR end: LONGINT; r: Texts.Reader; e: Texts.Elem;
BEGIN end := TextFrames.Pos(f, f.X + f.W, f.Y);
	IF end + 1 = f.text.len THEN INC(end) END; 
		-- ErrorElem inserted at f.text.len causes Pos to return the wrong position *)
	Texts.OpenReader(r, f.text, f.org);
	LOOP Texts.ReadElem(r);
		IF (r.elem = NIL) OR (Texts.Pos(r) > end) THEN RETURN FALSE
		ELSIF r.elem IS ErrElem THEN RETURN TRUE
		END
END ErrVisible;
PROCEDURE GetErrMsg (err: INTEGER; VAR msg: ARRAY OF CHAR);	
	VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
BEGIN Texts.OpenScanner(s, errT, 0);
	REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Int) & (s.i = 0);
	WHILE ~ s.eot & ((s.class # Texts.Int) OR (s.i # err)) DO Texts.Scan(s) END;
	IF ~s.eot THEN Texts.Read(s, ch); n := 0;
		WHILE ~s.eot & (ch # CR) DO msg[n] := ch; INC(n); Texts.Read(s, ch) END;
		msg[n] := 0X
END GetErrMsg;
PROCEDURE SetProfile*;	
	VAR s: Texts.Scanner; t: Texts.Text; f: Files.File;
BEGIN
	compName := "Compiler.Compile"; errFile := "OberonErrors.Text"; globOpt := ""; showWarnings := TRUE;
	f := Files.Old(profile);
	IF f # NIL THEN NEW(t); Texts.Open(t, profile); Texts.OpenScanner(s, t, 0); Texts.Scan(s);
		WHILE ~ s.eot DO
			IF s.class = Texts.Name THEN
				IF s.s = "compiler" THEN
					Texts.Scan(s); Texts.Scan(s); COPY(s.s, compName);
					GetOptions(s, globOpt)
				ELSIF s.s = "errorFile" THEN
					Texts.Scan(s); Texts.Scan(s); COPY(s.s, errFile)
				ELSIF s.s = "showWarnings" THEN
					Texts.Scan(s); Texts.Scan(s);
					showWarnings := s.s = "yes"
				END
			END;
			Texts.Scan(s)
		END
	END;
	errT := TextFrames.Text(errFile)
END SetProfile;
PROCEDURE Compile*;	
	VAR f: TextFrames.Frame; t: Texts.Text; res: INTEGER; s: Texts.Scanner;
		beg, end, time, pos: LONGINT; v: MenuViewers.Viewer; oldNotify: Texts.Notifier; par: Oberon.ParList;
		ready: BOOLEAN; opt: Options;
BEGIN
	par := Oberon.Par;
	Texts.OpenScanner(s, par.text, par.pos); 
	REPEAT Texts.Scan(s); t := NIL; f := NIL; ready := FALSE;
		IF par.vwr.dsc = par.frame THEN
			f := par.frame.next(TextFrames.Frame);
			Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y);
			Oberon.FadeCursor(Oberon.Pointer);
			t := f.text; opt := globOpt; ready := TRUE
		ELSE
			IF s.class = Texts.Name THEN t := TextFrames.Text(s.s)
			ELSIF (s.class = Texts.Char) & (s.c = "*") THEN
				f := MarkedFrame(); IF f # NIL THEN t := f.text END;
				ready := TRUE
			ELSIF (s.class = Texts.Char) & (s.c = "^") THEN
				Oberon.GetSelection(t, beg, end, time);
				IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s); 
					IF s.class = Texts.Name THEN t := TextFrames.Text(s.s) END
				END
			END;
			GetOptions(s, opt)
		END;
		IF t # NIL THEN
			DeleteErrElems(t);
			oldNotify := t.notify; t.notify := NoNotify;
			FoldElems.ExpandAll(t, 0, TRUE);
			IF f = NIL THEN OpenTempViewer(t, v) ELSE DeleteErrElems(t) END;
			par.text := TextFrames.Text(""); Texts.Write(w, "*"); Texts.WriteString(w, opt);
			Texts.Append(par.text, w.buf); par.pos := 0; pos := Oberon.Log.len;
			Oberon.Call(compName, par, FALSE, res);
			IF (res = 0) & (f # NIL) THEN InsertErrElems(f, t, pos) END;
			FoldElems.CollapseAll(t, {FoldElems.tempLeft});
			IF f = NIL THEN
				Viewers.Close(v)
			ELSE
				t.notify := oldNotify;
				IF errors # 0 THEN t.notify(t, Texts.replace, 0, t.len) END
			END
		END
	UNTIL (t = NIL) OR ready
END Compile;
PROCEDURE ShowError*;	
	VAR F: Display.Frame; pos: LONGINT; e: Texts.Elem; msg: ARRAY 128 OF CHAR;
BEGIN
	IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN F := Oberon.Par.frame.next
	ELSE F := Oberon.FocusViewer.dsc.next
	END;
	WITH F: TextFrames.Frame DO
		IF F.hasCar THEN pos := F.carloc.pos ELSE pos := 0 END;
		FoldElems.FindElem(F.text, pos, ErrCheck, e);
		IF e # NIL THEN pos := Texts.ElemPos(e);
			Show(F, pos);
			Oberon.PassFocus(Viewers.This(F.X, F.Y));
			TextFrames.SetCaret(F, pos + 1);
			GetErrMsg(e(ErrElem).err, msg);
			Texts.WriteString(w, msg); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
		END
	ELSE
END ShowError;
BEGIN
	Texts.OpenWriter(w); SetProfile
END Folds.